home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / program / 363 / tprolog1 / calltree < prev    next >
Encoding:
Text File  |  1990-02-03  |  3.5 KB  |  94 lines
  1.  
  2. % Program structure analyser for TOY Prolog
  3. % (c) 1983 Kluzniak/Szpakowicz, IIUW Warszawa
  4.  
  5. calltree( Name/Arity ) :- add(proc(Name, Arity, Ord, Calls), Queue),
  6.                           fill(Queue, Queue),
  7.                           print_calls([proc(Name,Arity,Ord,Calls)],3,1,_).
  8.  
  9. add(El, [El | Tail]) :- !.
  10. add(El, [_ | Tail]) :- add(El, Tail).
  11.  
  12. fill([], _) :- !.
  13. fill([proc(Name,Arity,_,[])|QTail], Q) :- predefined(Name, Arity), !,
  14.                                           fill(QTail, Q).
  15.  
  16. fill([proc(Name,Arity,_,undefined)|QTail], Q) :-
  17.          not clause(Name, Arity, 1, _, _), !, fill(QTail, Q).
  18. fill([proc(Name, Arity,_,Calls)|QTail], Q) :-
  19.          add_calls(Name, Arity, 1, Calls, Q), fill(QTail, Q).
  20.  
  21. add_calls(Name, Arity, N, Calls, Q) :-
  22.          clause(Name, Arity, N, _, Body), !,
  23.          body_calls(Body, Calls, Q), sum(N, 1, N1),
  24.          add_calls(Name, Arity, N1, Calls, Q).
  25. add_calls(_, _, _, [], _) :- !.
  26. add_calls(_, _, _, _, _).
  27.  
  28. body_calls([], _, _) :- !.
  29. body_calls([Call | BodyTail], Calls, Q) :-
  30.          functor(Call, Name, Arity),
  31.          add(proc(Name,Arity,Ord,Callees), Calls),
  32.          add(proc(Name,Arity,Ord,Callees), Q),
  33.          add_insides(Call, Calls, Q),
  34.          body_calls(BodyTail, Calls, Q).
  35.  
  36. add_insides(Call, Q1, Q2) :- meta_call_1(Call, Arg), !,
  37.                              add_inside(Arg, Q1, Q2).
  38. add_insides(Call, Q1, Q2) :- meta_call_2(Call, Arg1, Arg2), !,
  39.                              add_inside(Arg1, Q1, Q2),
  40.                              add_inside(Arg2, Q1, Q2).
  41. add_insides(_, _, _).
  42.  
  43. add_inside(V, _, _) :- var(V), !.
  44. add_inside(N, _, _) :- integer(N), !.
  45. add_inside(Call, Q1, Q2) :- functor(Call, Name, Arity),
  46.                             add(proc(Name,Arity,Ord,Callees), Q1),
  47.                             add(proc(Name,Arity,Ord,Callees), Q2),
  48.                             add_insides(Call, Q1, Q2).
  49.  
  50. meta_call_1(call(Call), Call).
  51. meta_call_1(tag(Call), Call).
  52. meta_call_1(not Call, Call).
  53. meta_call_1(check(Call), Call).
  54. meta_call_1(side_effects(Call), Call).
  55. meta_call_1(once(Call), Call).
  56.  
  57. meta_call_2((A, B), A, B).
  58. meta_call_2((A; B), A, B).
  59.  
  60. print_calls([], _, Ord, Ord) :- !.
  61. print_calls([proc(Name,Arity,Ord,undefined) | Calls], Tab, Ord, NOrd) :-
  62.          !, start_undefined(Ord, Tab),
  63.          writeq(Name/Arity), display('    ** undefined **'), nl,
  64.          sum(Ord, 1, TOrd), print_calls(Calls, Tab, TOrd, NOrd).
  65. print_calls([proc(Name,Arity,Ord,Callees) | Calls], Tab, Ord, NOrd) :-
  66.          !, start_line(Ord, Tab), writeq(Name/Arity), nl,
  67.          sum(Tab, 3, InnerTab), sum(Ord, 1, InnerOrd),
  68.          print_calls(Callees, InnerTab, InnerOrd, TOrd),
  69.          print_calls(Calls, Tab, TOrd, NOrd).
  70. print_calls([proc(Name,Arity,AnotherOrd,_) | Calls], Tab, Ord, NOrd) :-
  71.          start_unnumbered_line(Tab), writeq(Name/Arity),
  72.          repetition(Name, Arity, AnotherOrd), nl,
  73.          print_calls(Calls, Tab, Ord, NOrd).
  74.  
  75. repetition(Name, Arity, _) :- predefined(Name, Arity), !.
  76. repetition(_, _, Ord) :- display('  (see '), display(Ord), display(')').
  77.  
  78. start_line(Ord, Tab) :- number_line(Ord), !, tab(Tab, ' ').
  79.  
  80. number_line(N) :- N < 10, display('   '), display(N).
  81. number_line(N) :- N < 100, display('  '), display(N).
  82. number_line(N) :- N < 1000, display(' '), display(N).
  83. number_line(N) :- display(N).
  84.  
  85. start_unnumbered_line(Tab) :- display('    '), tab(Tab, ' ').
  86.  
  87. start_undefined(Ord, Tab) :- number_line(Ord), tab(Tab, '.').
  88.  
  89. tab(0, _) :- !.
  90. tab(N, Ch) :- wch(Ch), sum(N1, 1, N), tab(N1, Ch).
  91.  
  92. end.
  93.  
  94.